home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / anomyo1a / main.frm next >
Text File  |  1998-03-28  |  9KB  |  276 lines
  1. VERSION 5.00
  2. Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
  3. Begin VB.Form frmMain 
  4.    Caption         =   "SMTP E-Mail Tester"
  5.    ClientHeight    =   4845
  6.    ClientLeft      =   60
  7.    ClientTop       =   345
  8.    ClientWidth     =   7185
  9.    Icon            =   "Main.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    ScaleHeight     =   4845
  13.    ScaleWidth      =   7185
  14.    StartUpPosition =   2  'CenterScreen
  15.    Begin VB.Frame Frame1 
  16.       Caption         =   "Status:"
  17.       Height          =   615
  18.       Left            =   960
  19.       TabIndex        =   15
  20.       Top             =   3480
  21.       Width           =   5175
  22.       Begin VB.Label StatusTxt 
  23.          Height          =   255
  24.          Left            =   120
  25.          TabIndex        =   16
  26.          Top             =   240
  27.          Width           =   4935
  28.       End
  29.    End
  30.    Begin VB.TextBox txtEmailServer 
  31.       Height          =   285
  32.       Left            =   3600
  33.       TabIndex        =   13
  34.       Top             =   1440
  35.       Width           =   3375
  36.    End
  37.    Begin VB.TextBox ToNametxt 
  38.       Height          =   285
  39.       Left            =   3600
  40.       TabIndex        =   11
  41.       Top             =   840
  42.       Width           =   3375
  43.    End
  44.    Begin VB.TextBox txtFromName 
  45.       Height          =   285
  46.       Left            =   3600
  47.       TabIndex        =   9
  48.       Top             =   240
  49.       Width           =   3375
  50.    End
  51.    Begin VB.CommandButton Command2 
  52.       Caption         =   "&Exit"
  53.       Height          =   495
  54.       Left            =   4440
  55.       TabIndex        =   8
  56.       Top             =   4200
  57.       Width           =   1695
  58.    End
  59.    Begin VB.TextBox txtEmailBodyOfMessage 
  60.       Height          =   1455
  61.       Left            =   120
  62.       MultiLine       =   -1  'True
  63.       ScrollBars      =   2  'Vertical
  64.       TabIndex        =   7
  65.       Top             =   1920
  66.       Width           =   6855
  67.    End
  68.    Begin VB.TextBox txtEmailSubject 
  69.       Height          =   285
  70.       Left            =   120
  71.       TabIndex        =   5
  72.       Top             =   1440
  73.       Width           =   3255
  74.    End
  75.    Begin VB.TextBox txtToEmailAddress 
  76.       Height          =   285
  77.       Left            =   120
  78.       TabIndex        =   3
  79.       Top             =   840
  80.       Width           =   3255
  81.    End
  82.    Begin VB.TextBox txtFromEmailAddress 
  83.       Height          =   285
  84.       Left            =   120
  85.       TabIndex        =   1
  86.       Top             =   240
  87.       Width           =   3255
  88.    End
  89.    Begin VB.CommandButton Command1 
  90.       Caption         =   "&Send E-Mail"
  91.       Height          =   495
  92.       Left            =   960
  93.       TabIndex        =   0
  94.       Top             =   4200
  95.       Width           =   2175
  96.    End
  97.    Begin MSWinsockLib.Winsock Winsock1 
  98.       Left            =   3480
  99.       Top             =   4200
  100.       _ExtentX        =   741
  101.       _ExtentY        =   741
  102.       _Version        =   327681
  103.    End
  104.    Begin VB.Label Label6 
  105.       Caption         =   "E-Mail Server"
  106.       Height          =   255
  107.       Left            =   3600
  108.       TabIndex        =   14
  109.       Top             =   1200
  110.       Width           =   3375
  111.    End
  112.    Begin VB.Label Label5 
  113.       Caption         =   "There Name"
  114.       Height          =   255
  115.       Left            =   3600
  116.       TabIndex        =   12
  117.       Top             =   600
  118.       Width           =   3375
  119.    End
  120.    Begin VB.Label Label4 
  121.       Caption         =   "Your Name"
  122.       Height          =   255
  123.       Left            =   3600
  124.       TabIndex        =   10
  125.       Top             =   0
  126.       Width           =   3135
  127.    End
  128.    Begin VB.Label Label3 
  129.       Caption         =   "Subject"
  130.       Height          =   255
  131.       Left            =   120
  132.       TabIndex        =   6
  133.       Top             =   1200
  134.       Width           =   1215
  135.    End
  136.    Begin VB.Label Label2 
  137.       Caption         =   "To"
  138.       Height          =   255
  139.       Left            =   120
  140.       TabIndex        =   4
  141.       Top             =   600
  142.       Width           =   1575
  143.    End
  144.    Begin VB.Label Label1 
  145.       Caption         =   "From (e-mail address)"
  146.       Height          =   255
  147.       Left            =   120
  148.       TabIndex        =   2
  149.       Top             =   0
  150.       Width           =   1575
  151.    End
  152. End
  153. Attribute VB_Name = "frmMain"
  154. Attribute VB_GlobalNameSpace = False
  155. Attribute VB_Creatable = False
  156. Attribute VB_PredeclaredId = True
  157. Attribute VB_Exposed = False
  158. Dim Response As String, Reply As Integer, DateNow As String
  159. Dim first As String, Second As String, Third As String
  160. Dim Fourth As String, Fifth As String, Sixth As String
  161. Dim Seventh As String, Eighth As String
  162. Dim Start As Single, Tmr As Single
  163.  
  164.  
  165.  
  166. Sub SendEmail(MailServerName As String, FromName As String, FromEmailAddress As String, ToName As String, ToEmailAddress As String, EmailSubject As String, EmailBodyOfMessage As String)
  167.           
  168.     Winsock1.LocalPort = 0 ' Must set local port to 0 (Zero) or you can only send 1 e-mail pre program start
  169.     
  170. If Winsock1.State = sckClosed Then ' Check to see if socet is closed
  171.     DateNow = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & " -0600"
  172.     first = "mail from:" + Chr(32) + FromEmailAddress + vbCrLf ' Get who's sending E-Mail address
  173.     Second = "rcpt to:" + Chr(32) + ToEmailAddress + vbCrLf ' Get who mail is going to
  174.     Third = "Date:" + Chr(32) + DateNow + vbCrLf ' Date when being sent
  175.     Fourth = "From:" + Chr(32) + FromName + vbCrLf ' Who's Sending
  176.     Fifth = "To:" + Chr(32) + ToNametxt + vbCrLf ' Who it going to
  177.     Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf ' Subject of E-Mail
  178.     Seventh = EmailBodyOfMessage + vbCrLf ' E-mail message body
  179.     Ninth = "X-Mailer: EBT Reporter v 2.x" + vbCrLf ' What program sent the e-mail, customize this
  180.     Eighth = Fourth + Third + Ninth + Fifth + Sixth  ' Combine for proper SMTP sending
  181.  
  182.     Winsock1.Protocol = sckTCPProtocol ' Set protocol for sending
  183.     Winsock1.RemoteHost = MailServerName ' Set the server address
  184.     Winsock1.RemotePort = 25 ' Set the SMTP Port
  185.     Winsock1.Connect ' Start connection
  186.     
  187.     WaitFor ("220")
  188.     
  189.     StatusTxt.Caption = "Connecting...."
  190.     StatusTxt.Refresh
  191.     
  192.     Winsock1.SendData ("HELO worldcomputers.com" + vbCrLf)
  193.  
  194.     WaitFor ("250")
  195.  
  196.     StatusTxt.Caption = "Connected"
  197.     StatusTxt.Refresh
  198.  
  199.     Winsock1.SendData (first)
  200.  
  201.     StatusTxt.Caption = "Sending Message"
  202.     StatusTxt.Refresh
  203.  
  204.     WaitFor ("250")
  205.  
  206.     Winsock1.SendData (Second)
  207.  
  208.     WaitFor ("250")
  209.  
  210.     Winsock1.SendData ("data" + vbCrLf)
  211.     
  212.     WaitFor ("354")
  213.  
  214.  
  215.     Winsock1.SendData (Eighth + vbCrLf)
  216.     Winsock1.SendData (Seventh + vbCrLf)
  217.     Winsock1.SendData ("." + vbCrLf)
  218.  
  219.     WaitFor ("250")
  220.  
  221.     Winsock1.SendData ("quit" + vbCrLf)
  222.     
  223.     StatusTxt.Caption = "Disconnecting"
  224.     StatusTxt.Refresh
  225.  
  226.     WaitFor ("221")
  227.  
  228.     Winsock1.Close
  229. Else
  230.     MsgBox (Str(Winsock1.State))
  231. End If
  232.    
  233. End Sub
  234. Sub WaitFor(ResponseCode As String)
  235.     Start = Timer ' Time event so won't get stuck in loop
  236.     While Len(Response) = 0
  237.         Tmr = Start - Timer
  238.         DoEvents ' Let System keep checking for incoming response **IMPORTANT**
  239.         If Tmr > 50 Then ' Time in seconds to wait
  240.             MsgBox "SMTP service error, timed out while waiting for response", 64, MsgTitle
  241.             Exit Sub
  242.         End If
  243.     Wend
  244.     While Left(Response, 3) <> ResponseCode
  245.         DoEvents
  246.         If Tmr > 50 Then
  247.             MsgBox "SMTP service error, impromper response code. Code should have been: " + ResponseCode + " Code recieved: " + Response, 64, MsgTitle
  248.             Exit Sub
  249.         End If
  250.     Wend
  251. Response = "" ' Sent response code to blank **IMPORTANT**
  252. End Sub
  253.  
  254.  
  255. Private Sub Command1_Click()
  256.     SendEmail txtEmailServer.Text, txtFromName.Text, txtFromEmailAddress.Text, txtToEmailAddress.Text, txtToEmailAddress.Text, txtEmailSubject.Text